# xdcc-queue.pl
# vi: et sw=2
# 
# XDCC queue script
# Copyright (C) 2009  Harry Karvonen
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
#
#
# Author: Harry Karvonen <harry.karvonen@gmail.com>
#

# Changelog
#
# Version 1.4
# New feature added. Now script will recognice
# '/msg bot XDCC SEND <packet number>' message and add it to script's log.
#
# Version 1.3
# Queue managment changed. By default every bot have own queue
# Replace XPacket with normal hash
#
# Version 1.2
# No more case sensitive names
# No more problems with files with space
#
# Version 1.1
# Now possible log completed and failed files
#
# Version 1.0
# using object oriented programming style
# Queue managment
# Better performace, usability, etc.

use strict;
use POSIX qw(strftime);
use File::Basename;

################################################################################
#
# Script part
#
################################################################################

my $cmd = "xdcc";
my $method = "msg";
my $version = "1.4";
my $stop = 0;

my $queue_name = "default";
my $packet_queue = { $queue_name => [] }; # ref

# FIXME this isn't used propably right
my %queue_active = ("default" => 1);

my %filelists;

#
# Settings
#

my $active_downloads = 2;
my $active_downloads_per_queue = 1;

my $active_waits = 2;
my $active_waits_per_queue = 1;

my $log_file = Xchat::get_info("xchatdir") . "/xdcc-queue.log";

my @status_msg = (
        "failed",       # 0
        "in queue",     # 1
        "waiting send", # 2
        "downloading",  # 3
        "done"          # 4
);

Xchat::register("XDCC Queuer", $version, "Queue your XDCC packets and let " .
        "xchat take care of downloading");

################################################################################
#
# Hooks
#

Xchat::hook_print("DCC RECV Complete", "xdcc_complete");
Xchat::hook_print("DCC SEND Offer", "xdcc_offer");
Xchat::hook_print("DCC RECV Failed", "xdcc_failed");
Xchat::hook_print("DCC Rename", "xdcc_rename");
Xchat::hook_print("Message Send", "msg_hook");
my $my_msg_hook = Xchat::hook_print("Your Message", "msg_hook");

Xchat::hook_command($cmd, "parse_cmd");

################################################################################
#
# MAIN function
#

sub parse_cmd {
  my $command = $_[0][1];

  if ($command =~ m/^help$/i || $command eq "") {
    &show_help;
  } elsif ($command =~ m/^ql$/ ) {
    Xchat::print("listing queues:");
    my $i = 1;
    foreach (keys %$packet_queue) {
      Xchat::print("$i\t$_ active waits: " . $queue_active{$_});
      $i++;
    }
  } elsif ($command =~ m/^q$/ ) {
    if ($_[0][2]) {
      $queue_name = $_[0][2];

      &create_queue($queue_name);

      $queue_active{$queue_name} = $_[0][3] if $_[0][3] ne "";
      Xchat::print("Active wait set to " . $_[0][3]) if $_[0][3] ne "";
    }

    Xchat::print("Selected queue '$queue_name' active waits " .
                                                $queue_active{$queue_name});
  } elsif ($command =~ m/^s(?:how){0,1}$/i) {
    #my $qname = $_[0][2] || $queue_name;

    foreach (keys %$packet_queue) {
      Xchat::print("Queue '$_' packages:");
      &show_queue($_);
    }
#  } elsif ($command =~ m/^stop$/i) {
#    &stop_queue;
#  } elsif ($command =~ m/^start$/i) {
#    &start_queue;
  } elsif ($command =~ m/^flush$/i) {
    if ($_[0][2] and &is_queue($_[0][2])) {
      &flush_queue($_[0][2]);
    } else {
      Xchat::print("Cannot find queue '" . $_[0][2] . "'");
    }
  } elsif ($command =~ m/remove/i) {
#
# FIXME Channel and server and send only if waiting packets
#
    &xdcc_send_remove($_[0][2]);
    &remove_by_bot($_[0][2]);
    Xchat::print("Removed " . $_[0][2]);
  } elsif ($command =~ m/delete/i) {
    &remove_by_id($_[0][2]);
    Xchat::print("Deleted packet " . $_[0][2]);
  } elsif ($command =~ m/method$/i) {
    $method = $_[0][2];
  } else {
    if ($_[1][2] =~ m/^\s*[0-9,:-]+/) {
      Xchat::print("'Normal' queuing");
      &add_queue($_[0][1], $_[0][2]);
    } elsif ($_[0][2] =~ m/^\s*queue\s*$/) {
      Xchat::print("'New' queuing");
      &add_queue($_[0][1], $_[0][4], $_[0][3]);
    } elsif ($_[0][2] =~ m/list/) {
      &open_dialog($_[0][1]);
      Xchat::print("Geting " . $_[0][1] . " list", $_[0][1]);

      if ($_[0][3]) {
        &add_queue($_[0][1], $_[0][3], "filelist");
      } else {
        &xdcc_send_list($_[0][1]);
      }
    } elsif ($_[0][2] =~ m/^fl$/) {
      if ($_[0][3]) {
        &read_filelist($_[0][1], $_[0][3]);
      }

      &show_filelist($_[0][1]);
    } else {
      Xchat::print("Unknown command: '/" . $_[1][0] . "'");
    }
  }

  return Xchat::EAT_ALL;
}

sub parse_packets {
  my $src = shift;
  my $parse;

  # Split already 2,3,5 formats packets
  my @split = split(/,/, $src);

  foreach my $tmp (@split) {
    if ($tmp =~ m/([0-9]+)-([0-9]+)/) {
      my @s = ($1, $2);

      # x - n packets x < n
      if ($s[0] < $s[1]) {
        foreach($s[0]...$s[1]) {
          $parse .= $_ . ",";
        }
      } else {
        # x - n packets x > n
        for (my $x = $s[0]; $x >= $s[1]; $x--) {
          $parse .= $x . ",";
        }
      }
    # 1:10:2 -> 1,3,5,7,9
    } elsif ($tmp =~ m/(\d+):(\d+):(\d+)/) {
      my @s;

      @s = ($1, $2, $3);

      if ($1 < $2) {
        for (my $x = $s[0]; $x <= $s[1]; $x += $s[2]) {
          $parse .= $x . ",";
        }
      } else {
        for (my $x = $s[0]; $x >= $s[1]; $x -= $s[2]) {
          $parse .= $x . ",";
        }
      }

    # normal packets z
    } elsif ($tmp =~ m/[0-9]+/) {
      $parse .= $tmp . ",";
    } else {
      Xchat::print("Can't parse \"" . $tmp . "\"");
    }
  }

  # eat last , char
  chomp $parse;

  return split /,/, $parse;
}

sub is_queue {
  my $qname = shift;
  return defined $packet_queue->{$qname};
}

sub create_queue {
  my $qname = shift;

  if (not &is_queue($qname)) {
    Xchat::print("Creating new queue '$qname'");
    $packet_queue->{$qname} = [];
    $queue_active{$qname} = 1;
  }
}

sub select_queue {
  my $name = shift;

  if (&is_queue($name)) {
    $queue_name = $name;
    return 1;
  }

  Xchat::print("Queue '$name' is undefined");

  return 0;
}

sub flush_queue {
  my $qname = shift || $queue_name;

  Xchat::print("Flushing $qname");
  $packet_queue->{$qname} = [];
}

sub show_queue {
  my $qname = shift;

  if (not &is_queue($qname)) {
    Xchat::print("Cannot find queue '" . $qname . "'");
    return
  }


  if (scalar(@{$packet_queue->{$qname}}) <= 0) {
    Xchat::print("$qname queue is empty.");
    return
  }

  if (&count_status(1, $qname) != 0) {
    Xchat::print("Queued:\t");
    &show_by_status(1, $qname);
  }

  if (&count_status(2, $qname) != 0) {
    Xchat::print("Waiting:\t");
    &show_by_status(2, $qname);
  }

  if (&count_status(3, $qname) != 0) {
    Xchat::print("Down.:\t");
    &show_by_status(3, $qname);
  }

  if (&count_status(4, $qname) != 0) {
    Xchat::print("Completed:\t");
    &show_by_status(4, $qname);
  }

  if (&count_status(0, $qname) != 0) {
    Xchat::print("Failed:\t");
    &show_by_status(0, $qname);
  }
}

sub count_connections {
  my $count = 0;

  foreach (keys %$packet_queue) {
    $count += &count_status(3, $_);
  }

  return $count;
}

sub count_waits {
  my $count = 0;

  foreach (keys %$packet_queue) {
    $count += &count_status(2, $_);
  }

  return $count;
}

sub count_status {
  my $status = shift;
  my $name = shift || $queue_name;
  my $count = 0;

  foreach (@{$packet_queue->{$name}}) {
    if ($_->{"status"} == $status) {
      $count++;
    }
  }

  return $count;
}

sub show_by_status {
  my $status = shift;
  my $qname = shift || $queue_name;
  my $id = 0;

  foreach (@{$packet_queue->{$qname}}) {
    if ($_->{"status"} == $status) {
      Xchat::print("$id: " .
        $_->{"bot"} . " " .
        $status_msg[$_->{"status"}] .
        " channel\@server: " .
        $_->{"channel"} . "\@" . $_->{"server"} .
        " filename: " . $_->{"filename"});
    }

    $id++;
  }
}

sub show_filelist {
  my $bot = shift;

  if (not defined $filelists{lc $bot}) {
    Xchat::print("$bot has not loaded filelist");
    return;
  }

  foreach (@{$filelists{lc $bot}}) {
    Xchat::print($_, $bot);
  }
}

sub read_filelist {
  my $bot = lc shift;
  my $filelist = shift;

  open FL, $filelist;
  $filelists{$bot} = [<FL>];
  close FL;

 chomp @{$filelists{$bot}};
}

sub count_filelist {
  my $bot = shift;

  if (not defined $filelists{lc $bot}) {
   Xchat::print("$bot has not loaded filelist");
   return 0;
  }

  return scalar(@{$filelists{lc $bot}});
}

sub open_dialog {
  Xchat::command("dialog " . $_[0]);
}

################################################################################
#
# HELP
#

sub show_help {
  Xchat::print("XDCC script v$version usage:");
  Xchat::print("Commands:");
  Xchat::print("$cmd help - show this help");
  Xchat::print("$cmd q - shows and set selected queue");
  Xchat::print("$cmd show - show packets queue (list also packet-id)");
  Xchat::print("$cmd flush - flush queue");
  Xchat::print("$cmd remove <bot> - remove bot packet and " .
                "send \"xdcc remove\"");
  Xchat::print("$cmd delete <pack-id> - delete packet by id, don't send " .
                "\"xdcc remove\"");
  Xchat::print("$cmd method <msg|ctcp> - set method CTCP or MSG");
  Xchat::print("$cmd <botname> <packets> - add bot and packets to selected queue");
  Xchat::print("$cmd <botname> queue <queue> <packets> - add bot and packets to defined queue (creates new if not exists)");
  Xchat::print("                        packets is separeted with ',' or" .
                        " '-'. etc. 1,2,3,4 and 1-4 is equal. 4-1 is 4,3,2,1");
  Xchat::print(
        "           those two style can merge 3,5-7,1,10-8,2 is 3,5,6,7,1,10,9,8,2");
  Xchat::print("Bug report can send to 'hate' \@ Rizon");
  
  return Xchat::EAT_ALL;
}

################################################################################
#
## LOGGING
#

sub xdcc_log {
  my $msg = shift;

  if (open(LOGFILE, ">>$log_file")) {
    my $timestamp = strftime "[%x-%H:%M:%S]", gmtime;
    print LOGFILE "$timestamp $msg\n";
  } else {
    Xchat::print("ERROR opening $log_file");
  }

  Xchat::print($msg);

  close LOGFILE;
}

################################################################################
#
## XDCC COMMANDS
#

sub xdcc_send_list {
  Xchat::command("msg " . $_[0] . " xdcc list", $_[1], $_[2]);
}

sub xdcc_send_remove {
  Xchat::command($method . " " . $_[0] . " xdcc remove", $_[1], $_[2]);
}

sub xdcc_send_packet {
  Xchat::unhook($my_msg_hook);
  Xchat::command($method . " " . $_[0] . " xdcc send #" . $_[1], $_[2], $_[3]);
  $my_msg_hook = Xchat::hook_print("Your Message", "msg_hook");
}

# FIXME channel and server definition
sub xdcc_accept_offer {
  Xchat::command("DCC GET " . $_[0] . " \"" . $_[1] . "\"");
}

################################################################################
#
## XDCC HOOKS
#

# Called when XDCC bot offers file to downloading
sub xdcc_offer {
  my $bot = $_[0][0];
  my $fn = $_[0][1];
  my $packet = 0;

  foreach (keys %$packet_queue) {
    $packet = &find_first_packet_by_bot(2, $bot, $_);
    last if $packet;
  }

  if ($packet) {
    &xdcc_accept_offer($bot, $fn);

    $$packet->{"status"} = 3;
    $$packet->{"filename"} = $fn;
    $$packet->{"mapped_filename"} = (Xchat::get_prefs("dcc_completed_dir") ?
          Xchat::get_prefs("dcc_completed_dir") : Xchat::get_prefs("dcc_dir")) .
        "/" . $fn;

    Xchat::hook_timer(1000, "run_queue");
  }

  return Xchat::EAT_NONE;
}

sub xdcc_complete {
  my $fn = $_[0][0];

  my $packet = 0;
  my $qname;

  foreach (keys %$packet_queue) {
    $packet =  &find_packet_by_file(3, $fn, $_);
    $qname = $_;
    last if $packet;
  }

  if ($packet) {
    $$packet->{"status"} = 4;

    xdcc_log("[$qname]\tCompleted: " . $$packet->{"bot"} . " :: " .
        $$packet->{"mapped_filename"});

    Xchat::hook_timer(1000, "run_queue");

    if (lc $qname eq "filelist") {
      &read_filelist($$packet->{"bot"}, $$packet->{"mapped_filename"});

      if (&count_filelist($$packet->{"bot"}) < 500) {
        &show_filelist($$packet->{"bot"});
      } else {
        Xchat::print("filelist is too long, if you want see it type '/xdcc " .
                     $$packet->{"bot"} ." fl' or use editor");
      }

    }
  } else {
    Xchat::print("Packet not found by file: " . $_[0][0]);
  }

  return Xchat::EAT_NONE;
}

sub xdcc_failed {
  my $fn = $_[0][0];

  my $packet = 0;

  foreach (keys %$packet_queue) {
    $packet =  &find_packet_by_file(3, $fn, $_);
    last if $packet;
  }

  if ($packet) {
    $$packet->{"status"} = 0;

    xdcc_log("Failed: " . $$packet->{"bot"} . " :: " .
        $$packet->{"filename"});

  }
}

sub xdcc_rename {
  my $old_fn = basename($_[0][0]);
  my $new_fn = $_[0][1];

  my $packet = 0;

  foreach (keys %$packet_queue) {
    $packet =  &find_packet_by_file(3, $old_fn, $_);
    last if $packet;
  }

  if ($packet) {
    $$packet->{"mapped_filename"} = $new_fn;
  }
}

################################################################################
#
## QUEUE functions
#

sub remove_by_bot {
  my $bot = lc shift;

  for (my $i = 0; $i <= scalar(@{$packet_queue->{$queue_name}}); $i++) {
    my $pack = $packet_queue->{$queue_name}[$i];

    if (lc $pack->{"bot"} eq $bot) {
      splice @{$packet_queue->{$queue_name}}, $i, 1;
      $i--;
    }
  }
}

sub remove_by_id {
  my $id = shift;

  splice @{$packet_queue->{$queue_name}}, $id, 1;
}

sub first_packet_by_status {
  my $status = shift;
  my $qname = shift || $queue_name;

  foreach (@{$packet_queue->{$qname}}) {
    if ($_->{"status"} == $status) {
      # Return pointer to packet
      return \$_;
    }
  }

  return 0;
}

sub find_packet_by_file {
  my $status = shift;
  my $fn = shift;
  my $qname = shift || $queue_name;

  foreach (@{$packet_queue->{$qname}}) {
    if ($_->{"filename"} eq $fn && $_->{"status"} == $status) {
      # Return pointer to packet
      return \$_;
    }
  }

  return 0;
}

sub find_first_packet_by_bot {
  my $status = shift;
  my $bot = lc shift;
  my $qname = shift || $queue_name;

  foreach (@{$packet_queue->{$qname}}) {
    if (lc $_->{"bot"} eq $bot && $_->{"status"} == $status) {
      # Return pointer to packet
      return \$_;
    }
  }

  return 0;
}

################################################################################
#
## Msg hook
#

sub msg_hook {
  my $bot_name = $_[0][0];
  my $msg = $_[0][1];

  if ($msg =~ m/^xdcc send #?(\d+)\s*$/i) {
    Xchat::print("xdcc msg catched");
    Xchat::print("packet $1 requested from $bot_name");

    my $packet = {
      "status" => 2,
      "bot" => $bot_name,
      "packet" => $1,
      "channel" => Xchat::get_info("channel"),
      "server" => Xchat::get_info("server")
    };

    &create_queue("manual");
    push @{$packet_queue->{"manual"}}, $packet;

  }

  return Xchat::EAT_NONE;
}

################################################################################
#
## QUEUE MANIPULATION functions
#

sub add_queue {
  my $bot_name = shift;
  my $packets = shift;
  my $qname = shift || $queue_name;

  if ($qname eq "") {
    Xchat::print("Queue name cannot be empty");
    return Xchat::EAT_ALL;
  }

  &create_queue($qname);

  &open_dialog($bot_name);

  Xchat::print("[$qname]\tFetch $packets from $bot_name", $bot_name);

  foreach (&parse_packets($packets)) {
    my $packet = { 
        "status" => 1,
        "bot" => $bot_name,
        "packet" => $_,
        "channel" => Xchat::get_info("channel"),
        "server" => Xchat::get_info("server")
    };

    push @{$packet_queue->{$qname}}, $packet;
  }

  Xchat::hook_timer(100, "run_queue");
  return Xchat::EAT_XCHAT;
}

#
## RUN queue
#

sub run_queue {
  my $packet;
  if ($stop == 1) { return Xchat::REMOVE; }

  foreach (keys %$packet_queue) {
    ############################################################################
    #
    # Send new packet
    #

    # E = is not normal queue
    # Q = there is room in waiting queue
    # P = there is room in downloading queue
    #
    # Send new packet if (E or Q) and (-E or Q and P) then send
    #
    if ( ($queue_active{$_} == 0 ||
          &count_status(2, $_) < $queue_active{$_}) &&
         ($queue_active{$_} != 0 ||
           (&count_status(2, $_) < 1 &&
            &count_status(3, $_) < 1)
         )
       ) {

      $packet = &first_packet_by_status(1, $_);

      if ($packet) {
        Xchat::print("[$_]\tRequesting packet #" . $$packet->{"packet"} .
                     " from " . $$packet->{"bot"});
        &xdcc_send_packet($$packet->{"bot"},
                          $$packet->{"packet"},
                          $$packet->{"channel"},
                          $$packet->{"server"});

        $$packet->{"status"} = 2;
      }
    }
  }

  return Xchat::REMOVE;
}

################################################################################
#
## END AND LOAD INFO
#

Xchat::print("XDCC Leeching queuer v" . $version . " loaded. Have fun!");

1;
